Hyper Stacks 1994 May/Hyper Stacks (Pacific HiTech)(1994)[Mac].iso/HyperTalk/FileName/FileName.p

Text File | 1987-11-18 | 8.5 KB | 280 lines | [TEXT/MPS ]

{
FileName:      A HyperCard "XFCN" (External Function) Resource
                        Version 1.11

Written By: Steve Maller
                         Apple Computer Training Support
                         Copyright © 1987 Apple Computer
                         AppleLink: MALLER1
                         Saturday, August 22, 1987 - 1.0
                        Tuesday, November 17, 1987 - 1.1 - smart window centering
                        Wednesday, November 18, 1987 - 1.11 - fixed initialization bug

Language:        MPW Pascal (with a little English thrown in for good measure )

To build:        pascal FileName.p
                        link -m ENTRYPOINT -rt XFCN=913 -sn Main=FileName ∂
                            -t STAK -c WILD ∂
                            FileName.p.o ∂
                            hd:dev:mpw:libraries:Interface.o ∂
                            hd:dev:mpw:PLibraries:Paslib.o ∂
                            -o "FileName XFCN"

Usage:            FileName("fileType")    -- "fileType" is optional

Examples:        FileName("STAK")            -- limits list to HyperCard Stacks
                        FileName("TEXT")            -- limits list to text files
                        FileName("APPL")            -- limits list to applications
                        FileName()                      -- lists ALL files

Result:            The full pathname of the selected file.
                        For example, if you selected the file "Address Stack" which is
                        in the folder "My Stacks" in the folder "HyperCard" on the
                        disk "HD" the result is:
                                    HD:HyperCard:My Stacks:Address Stack

Warning:        A word of caution: the Mac’s file system can NOT accept
                        pathnames longer than 255 characters. Be careful...

Script
Example:        on mouseUp
                            put FileName("TEXT") into theFile
                            if theFile is not empty then
                                open file theFile
                                read from file theFile for 2000
                                put it into bkgnd field 1
                                close file theFile
                            end if
                        end mouseUp

Why?                You must access files in HyperCard by their full pathname.
                        Unfortunately, HyperCard offers you no clear way of finding
                        out what that full name is. If files are on a hard disk, it
                        can be a real pain to remember the entire pathname. This
                        function simplifies that task for both the stackware developer
                        and the end user.

Thanks to:    The HyperCard Team - my heros!

}

{$S FileName }

UNIT Snoopy_Vs_TheRedBaron; { obviously this name is irrelevant }

{ =----------------------INTERFACE----------------------= }

    INTERFACE

        USES
            {$LOAD PasSymDump}
            MemTypes, QuickDraw, OSIntf, ToolIntf, PackIntf, HyperXCmd;

        PROCEDURE EntryPoint(paramPtr: XCmdPtr);

{ =----------------------IMPLEMENTATION----------------------= }

    IMPLEMENTATION

        {$R-}
        { no Pascal range checking }

        TYPE
            Str31 = String[31];                    { for the glue file “XCmdGlue.inc” }

        PROCEDURE FileName(paramPtr: XCmdPtr);
            FORWARD;

                { =----------------------EntryPoint----------------------= }

        PROCEDURE EntryPoint(paramPtr: XCmdPtr);

            BEGIN
                FileName(paramPtr);
            END;

                { =----------------------FileName----------------------= }

        PROCEDURE FileName(paramPtr: XCmdPtr);

            VAR
                myWDPB: WDPBPtr; { some variants of the same animal }
                myCPB: CInfoPBPtr;
                myPB: HParmBlkPtr;
                fullPathName: Str255;
                numTypes: Integer;
                reply: SFReply;
                typeList: SFTypeList;

                {$I XCmdGlue.inc }

                { =----------------------CenterWindow----------------------= }

            PROCEDURE CenterWindow(w: WindowPtr);

            { a general-purpose routine that will center the window who’s
                WindowPtr is passed in w. Here it is used to center the still-
                invisible SFGetFile dialog box. We’ll just steal the coordinates
                of the upper-left corner of the dialog to pass to SFGetFile... }

                VAR
                    hWindSize: Integer;
                    vWindSize: Integer;
                    hSize: Integer;
                    vSize: Integer;

                BEGIN
                    WITH w^.portBits.bounds DO        { find out how big the SCREEN is }
                        BEGIN
                            hSize := right - left;        { NOTE: this centers the window }
                            vSize := bottom - top;        { within screenBits.bounds ONLY. }
                        END;                                                { It will NOT recognize multiple }
                                                                                { monitors on a Mac II... }
                    WITH w^.portRect DO
                        BEGIN
                            hWindSize := right - left;    { get the size of the window }
                            vWindSize := bottom - top;
                        END;

                    { now move the window to the appropriate place on the screen }

                    MoveWindow(w, ((hSize - hWindSize) DIV 2),
                                                ((vSize - vWindSize + 20) DIV 2), FALSE);
                END;

            { =----------------------TheyChoseAFile----------------------= }

            FUNCTION TheyChoseAFile: Boolean;

                VAR
                    pt: Point;
                    wPtr: WindowPtr;
                    savePort: WindowPtr;

                BEGIN
                    TheyChoseAFile := FALSE;

                    GetPort(savePort);                            { save the current grafport }

                    { load in the SFGetFile DLOG resource for perousal }

                    wPtr := GetNewDialog(getDlgID, NIL, POINTER( - 1));

                    SetPort(wPtr);                                    { set port to it for LocalToGlobal }
                    CenterWindow(wPtr);                            { center (still invisible) window }
                    pt := wPtr^.portRect.topLeft;        { is 0,0 - but no assumptions! }
                    LocalToGlobal(pt);                            { convert this into global coords }

                    SFGetFile(pt, '', NIL, numTypes, typeList, NIL, reply);
                    { have ’em pick a file }

                    SetPort(savePort);                            { restore the grafport }

                    IF reply.good THEN { if they didn’t choose Cancel }
                        BEGIN
                            TheyChoseAFile := TRUE;
                            fullPathName := reply.fName; { start the ball rolling }
                        END;
                END;

            { =----------------------BuildThePathName----------------------= }

            PROCEDURE BuildThePathName;

                VAR
                    name: Str255;
                    err: Integer;

                BEGIN
                    name := '';                                                     { start with an empty name }
                    myPB^.ioNamePtr := @name;                         { we want the Volume name }
                    myPB^.ioCompletion := POINTER(0);
                    myPB^.ioVRefNum := reply.vRefNum;         { returned from SFGetFile }
                    myPB^.ioVolIndex := 0;                                 { use the vRefNum and name }
                    err := PBHGetVInfo(myPB, FALSE);             { fill in the Volume info }
                    IF err <> noErr THEN
                        Exit(FileName);

{ Now we need the Working Directory (WD) information because we’re going
 to step backwards from the file through all of the the folders until
 we reach the root directory }

                    myWDPB^.ioVRefNum := reply.vRefNum;     { this got set to 0 above }
                    myWDPB^.ioWDProcID := 0;                             { use the vRefNum }
                    myWDPB^.ioWDIndex := 0;                             { we want ALL directories }
                    err := PBGetWDInfo(myWDPB, FALSE);         { do it }
                    IF err <> noErr THEN
                        Exit(FileName);

                    myCPB^.ioFDirIndex := - 1;                         { use the ioDirID field only }
                    myCPB^.ioDrDirID := myWDPB^.ioWDDirID; { info returned above }
                    err := PBGetCatInfo(myCPB, FALSE);         { do it }
                    IF err <> noErr THEN
                        Exit(FileName);

{ Here starts the real work - start to climb the tree by continually
 looking in the ioDrParId field for the next directory above until we
 fail... }

                    myCPB^.ioDrDirID := myCPB^.ioDrParId;         { the first folder}
                    fullPathName := Concat(myCPB^.ioNamePtr^, ':', reply.fName);
                    REPEAT
                        myCPB^.ioDrDirID := myCPB^.ioDrParId;
                        err := PBGetCatInfo(myCPB, FALSE);             { the next level }

{ Be careful of an error returned here - it means the user chose a file
 on the desktop level of this volume. If this is the case, just stop
 here and return "VolumeName:FileName", otherwise loop until failure }
                        IF err = noErr THEN
                            fullPathName := Concat(myCPB^.ioNamePtr^, ':', fullPathName);

                    UNTIL err <> noErr;

                END; { PROCEDURE BuildThePathName }

            { =---------------------- * FileName * ----------------------= }

            BEGIN { PROCEDURE FileName }

{ First we allocate some memory in the heap for the parameter block. This
 could in theory work on the stack, but in reality it makes no difference
 as we’re entirely modal (ugh) here... }

                fullPathName := '';

                myCPB := CInfoPBPtr(NewPtr(SizeOf(HParamBlockRec)));
                IF ord4(myCPB) <= 0 THEN
                    Exit(FileName);                             { Rats! Bill didn’t leave enough room }
                myWDPB := WDPBPtr(myCPB);             { icky Pascal type coercions... }
                myPB := HParmBlkPtr(myCPB);

                numTypes := 1;                                     { for SFGetFile }
                WITH paramPtr^ DO
                    BEGIN
                        IF paramCount = 0 THEN
                            numTypes := - 1                     { FileName() - get all files }
                        ELSE
                            BlockMove(params[1]^, @typeList[0], 4);
                                                                                { FileName("TYPE") }

                        IF TheyChoseAFile THEN
                            BuildThePathName;

{ PasToZero is very interesting - it is a HyperTalk command
 that you can actually call from OUTSIDE of HyperCard.
 You need it because HyperCard uses C format strings with
 no length byte; they are terminated by a null byte. They are
 actually HANDLES to C format strings. Nice work, Dan! }

                        returnValue := PasToZero(fullPathName);

                    END; { WITH paramPtr^ DO }

                DisposPtr(POINTER(myCPB));             { Thou Shalt Clean Up Thy Heap! }

                numTypes := StringWidth('FileName version 1.11 • ©1987 Steve Maller');

            END; { PROCEDURE FileName }

END.